home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vidlibp / vidgen.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-01  |  8.4 KB  |  268 lines
  1. VERSION 2.00
  2. Begin Form VidGen 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Maintain "
  6.    ClientHeight    =   2205
  7.    ClientLeft      =   1860
  8.    ClientTop       =   2265
  9.    ClientWidth     =   6000
  10.    Height          =   2610
  11.    HelpContextID   =   245
  12.    Left            =   1800
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   2205
  17.    ScaleWidth      =   6000
  18.    Top             =   1920
  19.    Width           =   6120
  20.    Begin CommandButton cmdDelete 
  21.       Caption         =   "De&lete"
  22.       Height          =   465
  23.       HelpContextID   =   245
  24.       Left            =   3060
  25.       TabIndex        =   7
  26.       Top             =   1500
  27.       Width           =   1230
  28.    End
  29.    Begin CommandButton cmdDone 
  30.       Cancel          =   -1  'True
  31.       Caption         =   "&Done"
  32.       Height          =   465
  33.       HelpContextID   =   245
  34.       Left            =   4365
  35.       TabIndex        =   6
  36.       Top             =   1500
  37.       Width           =   1230
  38.    End
  39.    Begin CommandButton cmdUpdate 
  40.       Caption         =   "&Update"
  41.       Default         =   -1  'True
  42.       Height          =   465
  43.       HelpContextID   =   245
  44.       Left            =   1755
  45.       TabIndex        =   5
  46.       Top             =   1500
  47.       Width           =   1230
  48.    End
  49.    Begin CommandButton cmdAdd 
  50.       Caption         =   "&Add"
  51.       Height          =   465
  52.       HelpContextID   =   245
  53.       Left            =   450
  54.       TabIndex        =   4
  55.       Top             =   1500
  56.       Width           =   1230
  57.    End
  58.    Begin TextBox txtText 
  59.       BackColor       =   &H0000FFFF&
  60.       DataField       =   "GenText"
  61.       DataSource      =   "dtaGeneric"
  62.       Height          =   390
  63.       HelpContextID   =   245
  64.       Left            =   1395
  65.       MaxLength       =   50
  66.       TabIndex        =   1
  67.       Top             =   450
  68.       Width           =   4200
  69.    End
  70.    Begin TextBox txtCode 
  71.       BackColor       =   &H0000FFFF&
  72.       DataField       =   "GenCode"
  73.       DataSource      =   "dtaGeneric"
  74.       Height          =   390
  75.       HelpContextID   =   245
  76.       Left            =   450
  77.       MaxLength       =   1
  78.       TabIndex        =   0
  79.       Top             =   450
  80.       Width           =   645
  81.    End
  82.    Begin Data dtaGeneric 
  83.       Connect         =   ""
  84.       DatabaseName    =   "C:\VB\VIDLIB\VIDLIB.MDB"
  85.       Exclusive       =   0   'False
  86.       Height          =   270
  87.       Left            =   450
  88.       Options         =   0
  89.       ReadOnly        =   0   'False
  90.       RecordSource    =   "Genre"
  91.       Top             =   975
  92.       Width           =   5145
  93.    End
  94.    Begin Label lblText 
  95.       AutoSize        =   -1  'True
  96.       BackColor       =   &H00C0C0C0&
  97.       Caption         =   "Text:"
  98.       Height          =   195
  99.       Left            =   1395
  100.       TabIndex        =   3
  101.       Top             =   225
  102.       Width           =   450
  103.    End
  104.    Begin Label lblCode 
  105.       AutoSize        =   -1  'True
  106.       BackColor       =   &H00C0C0C0&
  107.       Caption         =   "Code:"
  108.       Height          =   195
  109.       Left            =   450
  110.       TabIndex        =   2
  111.       Top             =   225
  112.       Width           =   510
  113.    End
  114. ' Subsystem: Edit
  115. ' Module:    VidGen.Frm
  116. ' Date:      01/02/94
  117. ' Author:    Richard Stauch
  118. ' Notes:
  119. ' This Generic form serves two tables for editing,
  120. ' Genre and Rating. For more details on how this is
  121. ' accomplished, see the Form_Load event.
  122. Option Explicit
  123. DefInt A-Z
  124. Sub cmdAdd_Click ()
  125. ' Add a new record to the table.
  126. ' First, make sure the user can enter new data.
  127.   cmdUpdate.Enabled = True
  128.   txtCode.Enabled = True
  129.   txtText.Enabled = True
  130. ' Display the current activity.
  131.   dtaGeneric.Caption = "Adding record."
  132. ' Add a blank record.
  133.   dtaGeneric.Recordset.AddNew
  134. ' Set the input focus on the first input-capable field.
  135.   txtCode.SetFocus
  136. End Sub
  137. Sub cmdDelete_Click ()
  138. ' Delete the current record.
  139.   If Not CodeInUse(Left$(txtCode.Text, 1), Generic$) Then
  140.   ' This code is not in use.
  141.     dtaGeneric.Recordset.Delete ' Delete the record.
  142.     dtaGeneric.Refresh ' Rebuild the record set.
  143.     If dtaGeneric.Recordset.EOF And dtaGeneric.Recordset.BOF Then
  144.     ' The record set is empty, so disable text boxes and buttons.
  145.       cmdUpdate.Enabled = False
  146.       cmdDelete.Enabled = False
  147.       txtCode.Enabled = False
  148.       txtText.Enabled = False
  149.     ' Notify the user there are no records to edit.
  150.       dtaGeneric.Caption = "No valid record."
  151.     End If
  152.   Else
  153.   ' Notify user this code is in use.
  154.     Beep
  155.     GenericMsgBox (MBC_CODEINUSE)
  156.   End If
  157. End Sub
  158. Sub cmdDone_Click ()
  159. ' Remove the Generic form from the display.
  160.   Unload VidGen
  161. End Sub
  162. Sub cmdUpdate_Click ()
  163. ' Update the current record.
  164.   On Error GoTo UpdateError
  165.   If (txtCode.Text <> "") And (txtText.Text <> "") Then
  166.   ' There are no blanks in key fields, so update the record.
  167.     dtaGeneric.Recordset.Update
  168.   ' Make sure the user can delete records.
  169.     cmdDelete.Enabled = True
  170.   ' Rebuild the record set.
  171.     dtaGeneric.Refresh
  172.   ' Inform the user of the current operation.
  173.     dtaGeneric.Caption = "Editing record."
  174.   Else
  175.   ' Inform user that fields cannot be blank.
  176.     Beep
  177.     GenericMsgBox (MBC_NOBLANKS)
  178.   End If
  179. ' Set the input focus on the first input-capable field.
  180.   txtCode.SetFocus
  181.   Exit Sub
  182. UpdateError:
  183. ' Inform the user there's a problem with the data.
  184.   Beep
  185.   GenericMsgBox (MBC_BADDATA)
  186.   If dtaGeneric.Caption = "Adding record." Then
  187.   ' Cancel the Add operation, if it's working.
  188.     dtaGeneric.Recordset.AddNew
  189.     dtaGeneric.Recordset.Refresh
  190.   End If
  191.   Exit Sub
  192. End Sub
  193. Function CodeInUse (UseCode As String, CodeField As String) As Integer
  194. ' Open the Video table, and search for UseCode.
  195. Dim DB As Database ' Define the database object.
  196. Dim T As Dynaset   ' Define the table object.
  197. ' Open the current database, (Exclusive = False, Read-Only = True).
  198.   Set DB = OpenDatabase(PathName$, False, True)
  199. ' Use the Video table.
  200.   Set T = DB.CreateDynaset("Video")
  201. ' We use the FindFirst method to look up the UseCode,
  202. ' then reverse the logic of the NoMatch property.
  203.   If CodeField$ = "G" Then
  204.   ' The CodeField variable indicates (G)enre.
  205.     T.FindFirst "GenCode = '" + Left$(UseCode$, 1) + "'"
  206.     CodeInUse% = Not T.NoMatch
  207.   ElseIf CodeField$ = "R" Then
  208.   ' The CodeField variable indicates (R)ating.
  209.     T.FindFirst "RatCode = '" + Left$(UseCode$, 1) + "'"
  210.     CodeInUse% = Not T.NoMatch
  211.   Else
  212.   ' The CodeField variable is invalid.
  213.     CodeInUse% = False
  214.   End If
  215. ' We're finished, so close the database and table.
  216.   T.Close
  217.   DB.Close
  218. End Function
  219. Sub Form_Load ()
  220. ' Load the form, and alter the text fields according to the table
  221. ' in use. We do this before the Show method.
  222. ' First, make sure the Data control is using the right database.
  223.   dtaGeneric.DatabaseName = PathName$
  224. ' Set captions for Genre or Rating tables.
  225.   If Generic$ = "G" Then
  226.   ' We're using the Genre table.
  227.     VidGen.Caption = VidGen.Caption & "Genre Data"
  228.     dtaGeneric.RecordSource = "Genre"
  229.     txtCode.DataField = "GenCode"
  230.     txtText.DataField = "GenText"
  231.   ElseIf Generic$ = "R" Then
  232.   ' We're using the Rating table.
  233.     VidGen.Caption = VidGen.Caption & "Rating Data"
  234.     dtaGeneric.RecordSource = "Rating"
  235.     txtCode.DataField = "RatCode"
  236.     txtText.DataField = "RatText"
  237.   End If
  238. ' Refresh the record set.
  239.   dtaGeneric.Refresh
  240. ' Show the form on the display, so we can set input focus.
  241.   VidGen.Show
  242.   If dtaGeneric.Recordset.EOF And dtaGeneric.Recordset.BOF Then
  243.   ' The table is empty, so disable the update function.
  244.     cmdUpdate.Enabled = False
  245.     cmdDelete.Enabled = False
  246.     txtCode.Enabled = False
  247.     txtText.Enabled = False
  248.     dtaGeneric.Caption = "No valid record."
  249.   ' The user can still Add records.
  250.     cmdAdd.SetFocus
  251.   Else
  252.   ' There are records, so we default to Edit mode.
  253.     dtaGeneric.Caption = "Editing record."
  254.   ' Set the input focus to the first input-capable field.
  255.     txtCode.SetFocus
  256.   End If
  257. End Sub
  258. Sub txtCode_GotFocus ()
  259. ' Automatically select the entire string.
  260.   txtCode.SelStart = 0
  261.   txtCode.SelLength = Len(txtCode.Text)
  262. End Sub
  263. Sub txtText_GotFocus ()
  264. ' Automatically select the entire string.
  265.   txtText.SelStart = 0
  266.   txtText.SelLength = Len(txtText.Text)
  267. End Sub
  268.